Syntax10.Scn.Fnt
StampElems
Alloc
14 Feb 96
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
MODULE MarkElems;  (** HM 
IMPORT Files, Fonts, Display, Input, Viewers, Texts, TextFrames, TextPrinter, MenuViewers, Oberon;
CONST
	middle = 1; right = 0;
	pixel = LONG(10000);
	Elem* = POINTER TO ElemDesc;
	ElemDesc* = RECORD (Texts.ElemDesc)
		key*: LONGINT
	END ;
	Frame = POINTER TO FrameDesc;
	FrameDesc = RECORD (TextFrames.FrameDesc)
		e: Elem
	END ;
	backF*: TextFrames.Frame;	(**source frame of most recent link*)
	backE*: Texts.Elem;	(**most recently activated link elem*)
	icon, invIcon: Display.Pattern; (* x = 0, y = 3, w = 12, h = 8 *)
	w: Texts.Writer;
PROCEDURE ShowKey (e: Elem);
	VAR t: Texts.Text; v: MenuViewers.Viewer; f: Frame; x, y: INTEGER;
BEGIN
	t := TextFrames.Text(""); Texts.WriteInt(w, e.key, 0); Texts.Append(t, w.buf);
	NEW(f); f.e := e; TextFrames.Open(f, t, 0);
	Oberon.AllocateSystemViewer(0, x, y);
	v := MenuViewers.New(
		TextFrames.NewMenu("MarkElem", "System.Close  MarkElems.Update "),
		f, TextFrames.menuH, x, y)
END ShowKey;
PROCEDURE ShowPos (f: TextFrames.Frame; pos: LONGINT);
	VAR beg, end, delta: LONGINT;
BEGIN delta := 200;
	LOOP beg := f.org; end := TextFrames.Pos(f, f.X + f.W, f.Y);
		IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END ;
		TextFrames.Show(f, pos - delta); delta := delta DIV 2
END ShowPos;
PROCEDURE GoBack;
	VAR r: Texts.Reader; pos: LONGINT;
BEGIN
	IF backF # NIL THEN
		Texts.OpenReader(r, backF.text, 0);
		LOOP Texts.ReadElem(r);
			IF r.eot THEN EXIT END ;
			IF r.elem = backE THEN
				pos := Texts.Pos(r); ShowPos(backF, pos); TextFrames.SetSelection(backF, pos-1, pos);
				backF := NIL; EXIT
			END
		END
END GoBack;
PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
	VAR p: TextFrames.Parc; beg: LONGINT;
BEGIN
	IF f = NIL THEN
		IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
	ELSE
		TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
		dsr := SHORT(p.dsr DIV TextFrames.Unit)
END GetDsr;
PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
	VAR e1: Elem; x, y, dsr: INTEGER; keys: SET;
BEGIN
	WITH e: Elem DO
		WITH m: Texts.FileMsg DO
			IF m.id = Texts.load THEN Files.ReadLInt(m.r, e.key)
			ELSE (*Texts.store*) Files.WriteLInt(m.r, e.key)
			END
		| m: Texts.CopyMsg DO
			IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(Elem) END ;
			e1.key := e.key; Texts.CopyElem(e, e1)
		| m: Texts.IdentifyMsg DO
			m.mod := "MarkElems"; m.proc := "Alloc"
		| m: TextFrames.DisplayMsg DO
			IF ~m.prepare THEN
				GetDsr(m.frame, m.pos, m.fnt, dsr);
				Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.paint)
			ELSE
				e.W := 12 * pixel; e.H := 11 * pixel
			END
		| m: TextPrinter.PrintMsg DO
			IF m.prepare THEN e.W := 1 ELSE e.W := 12 * pixel END
		| m: TextFrames.TrackMsg DO
				IF middle IN m.keys THEN
					GetDsr(m.frame, m.pos, m.fnt, dsr);
					Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
					Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
					REPEAT Input.Mouse(keys, x, y); m.keys := m.keys + keys;
						Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
					UNTIL keys = {};
					Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
					Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
					IF m.keys = {middle} THEN GoBack
					ELSIF m.keys = {middle, right} THEN ShowKey(e)
					END
				END
		ELSE
		END
END Handle;
PROCEDURE New* (): Elem;
	VAR e: Elem;
BEGIN
	NEW(e); e.W := 12 * pixel; e.H := 11 * pixel; e.handle := Handle; e.key := Oberon.Time(); RETURN e
END New;
PROCEDURE MarkProcs*;
	VAR v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner; pos: LONGINT; ch: CHAR; key: LONGINT; mark: Elem;
BEGIN
	v := Oberon.MarkedViewer();
	IF v.dsc.next IS TextFrames.Frame THEN
		t := v.dsc.next(TextFrames.Frame).text;
		Texts.OpenScanner(s, t, 0); Texts.Scan(s); key := Oberon.Time();
		WHILE ~ s.eot DO
			IF (s.class = Texts.Name) & (s.s = "PROCEDURE") THEN
				pos := Texts.Pos(s);
				Texts.Scan(s);
				IF s.class = Texts.Char THEN
					IF (s.c = "^") OR (s.c = "*") OR (s.c = "-") THEN pos := Texts.Pos(s); Texts.Scan(s)
					ELSIF s.c = "(" THEN
						REPEAT Texts.Scan(s) UNTIL (s.class = Texts.Char) & (s.c = ")") OR s.eot;
						pos := Texts.Pos(s); Texts.Scan(s)
					END
				END ;
				IF s.class = Texts.Name THEN
					Texts.OpenReader(s, t, pos); Texts.Read(s, ch);
					IF (s.elem = NIL) OR ~(s.elem IS Elem) THEN
						mark := New(); mark.key := key; INC(key);
						Texts.WriteElem(w, mark); Texts.Insert(t, pos, w.buf)
					END ;
					Texts.OpenScanner(s, t, pos+1)
				END
			END ;
			Texts.Scan(s)
		END
END MarkProcs;
PROCEDURE ShowNext*;
	VAR f: Display.Frame; tf: TextFrames.Frame; pos: LONGINT; r: Texts.Reader;
BEGIN
	IF Oberon.FocusViewer # NIL THEN
		f := Oberon.FocusViewer.dsc.next;
		IF (f # NIL) & (f IS TextFrames.Frame) THEN
			tf := f(TextFrames.Frame);
			IF tf.hasCar THEN pos := tf.carloc.pos ELSE pos := 0 END ;
			Texts.OpenReader(r, tf.text, pos); Texts.ReadElem(r);
			WHILE ~r.eot & ~(r.elem IS Elem) DO Texts.ReadElem(r) END ;
			IF r.eot THEN TextFrames.RemoveCaret(tf)
			ELSE pos := Texts.Pos(r); ShowPos(tf, pos); TextFrames.SetCaret(tf, pos)
			END
		END
END ShowNext;
PROCEDURE Alloc*;
	VAR e: Elem;
BEGIN
	NEW(e); e.handle := Handle; Texts.new := e
END Alloc;
PROCEDURE Update*;
	VAR f: Frame; t: Texts.Text; s: Texts.Scanner; r: Texts.Reader; ch: CHAR;
BEGIN
	IF (Oberon.Par.frame = Oberon.Par.vwr.dsc) & (Oberon.Par.frame.next IS Frame) THEN
		f := Oberon.Par.frame.next(Frame);
		Texts.OpenScanner(s, f.text, 0); Texts.Scan(s);
		IF s.class = Texts.Int THEN
			f.e.key := s.i;
			t := Oberon.Par.frame(TextFrames.Frame).text;
			Texts.OpenReader(r, t, t.len-1); Texts.Read(r, ch);
			IF ch = "!" THEN Texts.Delete(t, t.len-1, t.len) END
		END
END Update;
PROCEDURE Insert*;
	VAR m: TextFrames.InsertElemMsg;
BEGIN
	m.e := New(); Viewers.Broadcast(m)
END Insert;
PROCEDURE InitIcon;
	VAR line: ARRAY 9 OF SET;
BEGIN
	line[1] := {4..7};
	line[2] := {3, 8};
	line[3] := {2, 9};
	line[4] := {2, 5, 6, 9};
	line[5] := {2, 5, 6, 9};
	line[6] := {2, 9};
	line[7] := {3, 8};
	line[8] := {4..7};
	icon := Display.NewPattern(line, 12, 8);
	line[1] := {};
	line[2] := {4..7};
	line[3] := {3..8};
	line[4] := {3, 4, 7, 8};
	line[5] := {3, 4, 7, 8};
	line[6] := {3..8};
	line[7] := {4..7};
	line[8] := {};
	invIcon := Display.NewPattern(line, 12, 8)
END InitIcon;
BEGIN
	Texts.OpenWriter(w); backF := NIL;
	InitIcon
END MarkElems.